perm filename 58810[PAG,LCS]1 blob
sn#629725 filedate 1981-12-19 generic text, type T, neo UTF8
00100 SUBROUTINE RESPC
00200 C RQ(2) IS R4, RQ(3) IS R5 ETC.
00300 COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00400 1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00500 1 RCLEF(0/7) /IVV/IV(1)
00600 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00700 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00800 COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00900 1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
01000 C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01100 DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01200 1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01300 INTEGER DUMMY
01400 COMMON /PX/PN(1) /Q/Q(1)
01500 1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01600 1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01700 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
01800 1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
01900 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02000 1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02100 1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02200 1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02300 DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
02400 1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/,ACCISZ/1.0/
02500 1 ,O1/0.01/,O11/0.011/
02600 C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
02700
02800 IF(NMPG.NE.'PAGEA')GO TO 2000
02900 C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
03000 RNEXT=0
03100 2000 SPCNT=1.0
03200 JX=0
03300 JCEN=0
03400 C FLAG FOR CENTERED RESTS.
03500 XT=0
03600 JK=1
03700 C JK IS USED AT END. IN SECTION TO FIND SIZE FACTOR FOR EACH BAR.
03800 PX=0
03900 CALL SHFT1(KQ)
04000 KK=L
04100 CC TYPE 3001,L
04200 C DELETES EXTRA BAR LINES, ETC.
04300 IF(IPG)CALL RESTS
04400 C??? IF(N)RETURN
04500 C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04600 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04700 CALL SHIFT
04800 C L=NUMBER OF ITEMS FOR RHY RECONS.
04900 JJ2=L+2
05000 C FOR WDCNT IN .PAG FILE
05100 IF(IPG.EQ.2)GO TO 11
05200 C IPG=2=REORDER INPUT FILE ONLY.
05300 N=0
05400 S=-100
05500 R=0
05600 KCLEF=0
05700 NOGRCE=-1
05800 C GRACE NOTE FLAG
05900 TTT=0
06000 C FOR IRREG. NUMS. OF STAVES.
06100
06200 C******** BIG LOOP ***************
06300 161 DO 601 K=1,L
06400 R=CODEN(KPN,K,Q,J)
06500 RZ=Q(J)
06600 CX J=KPN(K)
06700 CC N=N+1
06800 CC NN(N)=0
06900 CC MM(N)=J+3
07000 CALL MMNN(3)
07100 NN(N)=-R
07200 C MAKE ALL CODE NUMS NEG. AT FIRST. CHANGE 1,2,3,4,17,18 LATER
07300 CX R=Q(J+1)
07400 IF(R.GT.2)GO TO 1801
07500 IF(Q(J+2).GT.TTT)TTT=Q(J+2)
07600 C FINDS HIGHEST STAFF NUM. NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07700 IF(R.NE.1)GO TO 2801
07800 IF(RZ.LT.7)GO TO 601
07900 IF(Q(J+9).LE.0)GO TO 601
08000 C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
08100 IF(Q(J+9).NE.4./88.)GO TO 702
08200 CC IF(Q(J+9).GT..05)GO TO 702
08300 CC IF(Q(J+8).EQ.1000)GO TO 601
08400 C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
08500 NOGRCE=0
08600 GO TO 601
08700 CCC2801 IF(R.NE.2)GO TO 1801
08800 2801 RS=Q(J+7)
08900 IF(RZ.LT.7)GO TO 3801
09000 C DELETE ALL UP TO LABEL 1801 LATER. NEW CENTERED REST FEATURE. 5/29/78
09100 CXX NN(N)=-NN(N)
09200 IF(Q(J+9).NE.0)Q(J+9)=-1
09300 C SET UP WHOLE REST CENTERING. (P9=-1 CAUSES CENTERING AT OUTPUT TIME.)
09400 IF(Q(J+8).EQ.0)GO TO 601
09500 C SKIP IF WHOLE REST OVER CUE NOTES. (P8=0)
09600 IF(RS.LE.0)GO TO 601
09700 C SKIP RESTS WITH NO RHYTHM VALUE IN P7
09800 GO TO 702
09900 C??? NOW MAKE CODE NUM. POS.
10000 CC NN(N)=R
10100 CC GO TO 688
10200 3801 IF(RZ.LT.5)GO TO 601
10300 IF(RS.LE.0)GO TO 601
10400 IF(IPG)GO TO 702
10500 IF(RZ.LT.6)GO TO 702
10600 IF(Q(J+6))GO TO 702
10700 C PARAM 6=-1 = INVISIBLE. SHOULDN'T BE WHOLE REST (P8) ANYWAY.
10800 RS=Q(J+3)
10900 C GET POS. OF CENTERED WHOLE REST
11000 TT=0
11100 B=Q(J+2)
11200 C GET THE STAFF NUM.
11300 DO 602 M=1,L
11400 T=CODEN(KPN,M,Q,JJ)
11500 A=Q(JJ+3)
11600 C GET POS. OF ITEM
11700 IF(A.GT.RS)GO TO 602
11800 C JUMP IF ITEM IS TO RIGHT OF REST
11900 IF(T.NE.4)GO TO 602
12000 C IS THE ITEM A BAR LINE
12100 IF(Q(JJ+4).LT.0)GO TO 602
12200 C**** SKIP IF INVIS. BAR (P4=-1)
12300 IF(A.GT.TT)TT=A
12400 C FINDS BAR LINE CLOSEST TO LEFT OF REST
12500 602 CONTINUE
12600 C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
12700 T=20000
12800 A=20000
12900 C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
13000 DO 613 M=1,L
13100 IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
13200 IF(Q(JJ).LT.7)GO TO 609
13300 C SKIP IF RHYTH NOT IN P9
13400 IF(Q(JJ+9).LT..05)GO TO 613
13500 C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
13600 609 B=Q(JJ+3)
13700 C POS. OF ITEM
13800 X=B-TT
13900 IF(X)GO TO 613
14000 C JUMP IF ITEM IS TOO FAR TO LEFT
14100 IF(X.GT.A)GO TO 613
14200 A=X
14300 T=B
14400 C T = POS OF NOTE OR REST NEAREST BAR, ETC.
14500 613 CONTINUE
14600 IF(T.NE.20000)GO TO 612
14700 C JUMP IF NOTE OR REST FOUND
14800 JCEN=-1
14900 GO TO 1801
15000 612 Q(J+3)=T
15100 C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
15200 C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
15300 C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
15400 1801 IF(R.LT.4)GO TO 702
15500 IF(R.EQ.17)GO TO 1702
15600 IF(R.EQ.18)GO TO 1701
15700 IF(R.EQ.10)GO TO 702
15800 C FOUND A NUMBER. USE THIS IN RESTP
15900 IF(R.LE.7)GO TO 30
16000 IF(R.NE.44)GO TO 601
16100 IF(RZ.EQ.2)GO TO 601
16200 C RZ=2= BAR LINE ON UPPER STAFF
16300 IF(Q(J+6).EQ.0)GO TO 601
16400 IF(Q(J+5).EQ.0)GO TO 601
16500 C GETS LEFT END OF LINES, CRESC., DASHES.
16600 GO TO 604
16700 30 IF(R.NE.7)GO TO 605
16800 IF(RZ.LT.5)GO TO 604
16900 C JUMP FOR STANDARD TRILL
17000 RS=Q(J+7)
17100 IF(RS.EQ.1)GO TO 604
17200 IF(ABS(RS).GE.3)GO TO 604
17300 C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
17400 GO TO 601
17500 605 IF(R.NE.4)GO TO 604
17600 IF(Q(J+4).LT.0)GO TO 601
17700 C*** SKIP IF INVIS. BAR (P4=-1)
17800 IF(RZ.LE.3)GO TO 702
17900 C JUMP IF IT IS A BAR LINE
18000 CC IF(RZ.LT.4)GO TO 601
18100 IF(Q(J+6).NE.0)GO TO 604
18200 C GO GET OTHER POS OF LINE
18300 GO TO 601
18400 1701 IF(NN(N-1).NE.18)GO TO 1702
18500 IF(Q(J+2).EQ.Q(KPN(K-1)+2))Q(J+4)=-8.
18600 C SHIFT METER DOWN IF PREVIOUS ITEM WAS ALSO METER. (IN SAME POSITION)
18700 1702 IF(Q(J+4).NE.0)GO TO 601
18800 IF(Q(J+2).NE.0)GO TO 601
18900 C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
19000 702 NN(N)=-NN(N)
19100 CC702 NN(N)=R
19200 GO TO 601
19300 C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
19400 604 CALL MMNN(6)
19500 C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS (PUTS -1 INTO NN(X))
19600 CCXX NN(N)=-1
19700
19800 IF(R.NE.6)GO TO 601
19900 C NEXT FOR BEAMS
20000 IF(RZ.LT.8)GO TO 608
20100 IF(Q(J+10).EQ.0)GO TO 608
20200 IF(Q(J+8))GO TO 608
20300 C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
20400 IF(Q(J+7).GT.0)CALL MMNN(8)
20500 C NEXT SHIFTS P8 OF COMPOSITE BEAMS
20600 608 IF(RZ.LT.7)GO TO 601
20700 IF(Q(J+7))GO TO 688
20800 C P7 IS NEG FOR TREMOLO
20900 IF(Q(J+8).EQ.0)GO TO 601
21000 C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
21100 688 IF(Q(J+9).GT.0)CALL MMNN(9)
21200 C FOUND A POS. IN P9
21300 601 CONTINUE
21400
21500 KPG=TTT+1
21600 C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
21700
21800 C NEXT SORTS THE POINTS
21900 6000 J=1
22000 CC610 IF(NN(J).NE.-16)GO TO 1610
22100 C NEXT LOOKS FOR CONTINUATION OF TEXTS.(P10=1) PUTS ALL AT SAME P3 LOC.
22200 CC K=MM(J)
22300 CC IF(Q(K-3).LT.8)GO TO 1610
22400 CC IF(Q(K+7).EQ.1)Q(K)=Q(MM(J-1))
22500 CC GO TO 710
22600 CC1610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22700 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22800 CALL EXCHG(MM(J),NN(J))
22900 C ABOVE EXCHGS --(J) AND --(J+1)
23000 IF(J.EQ.1)GO TO 710
23100 J=J-1
23200 GO TO 610
23300 710 J=J+1
23400 IF(J.LT.N)GO TO 610
23500 C NOW ALL SORTED
23600 CALL FNDEND(R)
23700 CALL SHFTQ(R)
23800 C SHIFTS TO PROPER HORIZ. POS.
23900 IF(IPG)CALL RESTP
24000 C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS. (FOR PARTS ONLY)
24100 IF(N.LE.0)GO TO 122
24200 C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
24300
24400 DO 119 K=1,150
24500 119 HH(K)=0
24600 C HH ARRAY WILL HOLD FINAL COMPOSITE.
24700 G(1)=0
24800 E(1)=0
24900 F(1)=0
25000 RN(1500)=0
25100 RN(2500)=0
25200 ST=0
25300 C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
25400 C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
25500 KE=0
25600 J=1000
25700 933 JJ=1500
25800 JJJ=2000
25900 T=0
26000 M=0
26100 A=0
26200 B=0
26300
26400 DO 33 K=1,N
26500 IF(NORH(KK,K))GO TO 33
26600 CC KK=NN(K)
26700 CC IF(KK.EQ.0)GO TO 33
26800 CC IF(KK.EQ.4)GO TO 2133
26900 CC IF(KK.EQ.17)GO TO 2133
27000 C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
27100 CC IF(KK.EQ.18)GO TO 2133
27200 CC IF(KK.GT.2)GO TO 33
27300 2133 LL=MM(K)-3
27400 IF(KK.LE.2)GO TO 1133
27500 RH=O1
27600 C RHYTHMIC VALUE OF BARLINE, METER, KSIG
27700 CCC IF(KK.NE.4)RH=.6
27800 GO TO 3133
27900 1133 IF(Q(LL+2).NE.ST)GO TO 33
28000 C JUMP IF NOT ON RIGHT STAFF
28100 RA=9
28200 IF(KK.EQ.2)RA=7
28300 IF(Q(LL).LT.RA-2)GO TO 33
28400 C JUMP IF WDCNT IS TOO SHORT
28500 IF(KK.EQ.1)GO TO 433
28600 IF(Q(LL).LT.6)GO TO 433
28700 C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
28800 RZ=Q(LL+8)
28900 C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
29000 IF(RZ.LE.0)GO TO 433
29100 Q(LL+7)=2
29200 C 2 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST (WAS 3)
29300 IF(RZ.LT.8)GO TO 433
29400 Q(LL+5)=-3
29500 C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
29600 RZ=RZ/2.0
29700 CC RZ=IFIX(RZ/2.0)+1.0
29800 IF(RZ.GT.6)RZ=6
29900 C LIMIT OF 8 ON RHYTH VAL.
30000 Q(LL+7)=RZ
30100 433 RH=Q(LL+IFIX(RA))
30200 IF(RH.EQ.0)GO TO 33
30300 3133 RZ=Q(LL+3)
30400 IF(ZERO(RZ,A).EQ.0)GO TO 133
30500 C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
30600 RRH=RH
30700 C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
30800 TT=T
30900 C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
31000 J=J+1
31100 C UPDATE COUNTER IN POSITION ARRAY
31200 T=T+RH
31300 C ADD TO TOTAL RHYTHM
31400 RN(J)=T
31500 A=Q(LL+3)
31600 C SAVE POS. OF THIS NOTE.
31700 GO TO 33
31800 133 IF(RH.EQ.RHH)GO TO 33
31900 C IGNORE 2ND RHYTH IF SAME AS FIRST
32000 IF(ZERO(RZ,B).EQ.0)GO TO 333
32100 C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
32200 TTT=TT
32300 C SAVE TOTAL RHYTHM TO THIS POINT.
32400 TT=TT+RH
32500 JJ=JJ+1
32600 C UPDATE COUNTER FOR 2ND ARRAY
32700 RN(JJ)=TT
32800 RRRH=RH
32900 B=A
33000 GO TO 33
33100 333 IF(RH.EQ.RRRH)GO TO 33
33200 TTT=TTT+RH
33300 JJJ=JJJ+1
33400 RN(JJJ)=TTT
33500 33 CONTINUE
33600 C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
33700 IF(ST.NE.0)GO TO 733
33800 KE=J-999
33900 C TOTAL NUM OF RHYTHMS ON STAFF1.
34000 CC IF(JPG.EQ.0)GO TO 2233
34100 IF(KPG.LE.1)GO TO 2233
34200 C KPG=0=PARTS; =1=PAGE, 1 STAFF
34300 C JUMP IF ONLY ONE STAFF
34400 C****733 KF=J-2499
34500 C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
34600 733 ST=ST+1
34700 IF(ST.GT.1)GO TO 833
34800 C JUMP IF ALL STAVES HAVE BEEN READ.
34900 1233 J=2500
35000 GO TO 933
35100 833 IF(J.NE.2500)GO TO 1533
35200 C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
35300 C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
35400
35500 2233 CALL RLOOP(HH,E,KE)
35600 C FOR SINGLE STAFF OF RHYTHM
35700 KL=KE
35800 GO TO 1333
35900 1533 K=1
36000 L=1
36100 M=0
36200 19 KK=K
36300 LL=L
36400 1 SM=10000
36500 K=K+1
36600 IF(K.GT.KE)GO TO 10
36700 4 L=L+1
36800 Y=F(L)
36900 B=Y-F(L-1)
37000 IF(B.LT.SM)SM=B
37100 2 X=E(K)
37200 A=X-E(K-1)
37300 C A AND B HAVE TRUE DURATIONS NOW
37400 IF(A.LT.SM)SM=A
37500 C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
37600 IF(ZERO(X,Y).EQ.0)GO TO 3
37700 C JUMP IF EQUAL RHYTHS
37800 IF(X.GT.Y)GO TO 4
37900 K=K+1
38000 C STEP FORWARD UNTIL X IS .GT. Y
38100 GO TO 2
38200 3 IF(K.NE.KK+1)GO TO 13
38300 IF(L.NE.LL+1)GO TO 14
38400 M=M+1
38500 G(M)=E(KK)
38600 GO TO 19
38700 13 IF(L.NE.LL+1)GO TO 15
38800 DO 16 J=KK,K-1
38900 M=M+1
39000 16 G(M)=E(J)
39100 GO TO 19
39200 14 DO 17 J=LL,L-1
39300 M=M+1
39400 17 G(M)=F(J)
39500 GO TO 19
39600 15 XM=SM-.001
39700 M=M+1
39800 P=E(KK)
39900 G(M)=P
40000 7 KK=KK+1
40100 LL=LL+1
40200 YM=SM*1.5
40300 C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
40400 S=P
40500 T=P
40600 27 A=E(KK)
40700 B=F(LL)
40800 IF(ZERO(A,B).EQ.0)GO TO 19
40900 X=ZERO(A,P)
41000 Y=ZERO(B,P)
41100 C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT.O1)ZERO=0
41200 S=E(KK-1)
41300 T=F(LL-1)
41400 9 IF(A-S.LT.X-O1)X=ZERO(A,S)
41500 IF(B-T.LT.Y-O1)Y=ZERO(B,T)
41600 IF(A.GT.B+O1)GO TO 8
41700 B=A
41800 KK=KK+1
41900 62 IF(X.GT.YM)GO TO 5
42000 IF(X.EQ.0)GO TO 27
42100 P=P+SM
42200 25 M=M+1
42300 G(M)=P
42400 GO TO 27
42500 5 P=P+SM
42600 IF(P)GO TO 2203
42700 C IF(P)ERROR
42800 IF(P.LT.B-O1)GO TO 5
42900 GO TO 25
43000 8 X=Y
43100 LL=LL+1
43200 GO TO 62
43300 10 M=M+1
43400 G(M)=E(KE)
43500 CC TYPE 410,(E(K),K=1,KE)
43600 CC TYPE 410,(F(K),K=1,KF)
43700 CC TYPE 410,(G(K),K=1,M)
43800 CBCB WRITE(21,410)(E(K),K=1,KE)
43900 CB WRITE(21,410)(F(K),K=1,KF)
44000 CB WRITE(21,410)(G(K),K=1,M)
44100 410 FORMAT(10F7.2)
44200 C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
44300 C****** NO VITAL RHYTHMS CAN PASS BAR LINES *************
44400 1033 JJ=1
44500 H(1)=0
44600 J=1
44700 K=2
44800 L=2
44900 511 IF(J.EQ.M)GO TO 911
45000 J=J+1
45100 X=G(J)
45200 1211 A=E(K)
45300 B=F(L)
45400 Y=ZERO(X,A)
45500 Z=ZERO(X,B)
45600 IF(A-B.GT.O1)GO TO 1111
45700 IF(Y.EQ.0)GO TO 1311
45800 IF(X.LT.A-O1)GO TO 1111
45900 K=K+1
46000 1411 JJ=JJ+1
46100 H(JJ)=-A
46200 GO TO 1211
46300 1111 IF(Z.EQ.0)GO TO 1311
46400 IF(X.LT.B-O1)GO TO 1311
46500 L=L+1
46600 A=B
46700 GO TO 1411
46800
46900 1311 JJ=JJ+1
47000 H(JJ)=X
47100 IF(Y.EQ.0)GO TO 611
47200 IF(Z.EQ.0)GO TO 711
47300 IF(ZERO(A,B).EQ.0)GO TO 511
47400 P=A
47500 IF(P.GT.B+O1)GO TO 811
47600 IF(P.GT.X+O1)GO TO 511
47700 K=K+1
47800 GO TO 1011
47900 811 P=B
48000 IF(P.GT.X+O1)GO TO 511
48100 L=L+1
48200 1011 JJ=JJ+1
48300 H(JJ)=-P
48400 C NON-SPACED RHYTHS ARE NEG.
48500 GO TO 511
48600 611 K=K+1
48700 IF(Z.GT.0)GO TO 511
48800 711 L=L+1
48900 GO TO 511
49000 911 IF(HH(2).EQ.0)GO TO 2011
49100 K=2
49200 J=2
49300 L=1
49400 HHH(1)=0
49500 1511 IF(J.GT.JJ)GO TO 1811
49600 P=H(J)
49700 A=ABS(P)
49800 B=ABS(HH(K))
49900 IF(ZERO(B,A).EQ.0)GO TO 1611
50000 IF(A.GT.B)GO TO 1711
50100 J=J+1
50200 GO TO 1911
50300 1711 P=HH(K)
50400 GO TO 2211
50500 1611 J=J+1
50600 2211 K=K+1
50700 1911 L=L+1
50800 HHH(L)=P
50900 GO TO 1511
51000 2011 CALL RLOOP(HH,H,JJ)
51100 KL=JJ
51200 GO TO 2111
51300 1811 CALL RLOOP(HH,HHH,L)
51400 KL=L
51500 2111 IF(ST.GE.KPG)GO TO 1333
51600 CALL RLOOP(E,G,M)
51700 KE=M
51800 C GO WAY BACK AND READ ANOTHER LINE.
51900 GO TO 1233
52000 1333 E(1)=0
52100 GO TO 2333
52200 TYPE 410,(HH(K),K=1,KL)
52300 WRITE(21,410)(HH(K),K=1,KL)
52400 2333 JD=1
52500 C JD IS COUNTER FOR DUMMY POSITIONS.
52600 DUMMY(1)=1
52700 ST=0
52800 183 B=0
52900 LL=2
53000
53100 DO 181 K=1,N
53200 IF(NORH(L,K))GO TO 181
53300 C LOOK FOR DUMMY RHYTHMS.
53400 IF(L.LE.2)GO TO 2184
53500 RZ=O1
53600 C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
53700 GO TO 1184
53800 2184 LF=MM(K)
53900 IF(Q(LF-1).NE.ST)GO TO 181
54000 C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
54100 J=6
54200 IF(L.EQ.2)J=4
54300 RZ=Q(LF+J)
54400 1184 B=B+RZ
54500 184 V=ABS(HH(LL))
54600 IF(ZERO(B,V).GT.0)GO TO 182
54700 C FOUND RHYTH MATCH
54800 JD=JD+1
54900 DUMMY(JD)=LL
55000 LL=LL+1
55100 GO TO 181
55200 182 IF(B.LT.V-O1)GO TO 181
55300 LL=LL+1
55400 GO TO 184
55500 181 CONTINUE
55600 ST=ST+1
55700 IF(ST.LT.KPG)GO TO 183
55800
55900 C NEXT SORT DUMMY ARRAY
56000 J=0
56100 185 DO 186 K=2,JD
56200 IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
56300 DO 188 LL=K,JD
56400 188 DUMMY(LL-1)=DUMMY(LL)
56500 JD=JD-1
56600 GO TO 185
56700 187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
56800 CALL EXCH(DUMMY(K),DUMMY(K-1))
56900 GO TO 185
57000 186 CONTINUE
57100 C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
57200 PX=0
57300 LF=0
57400 K=1
57500 V=0
57600
57700 81 K=K+1
57800 IF(K.GT.KL)GO TO 1433
57900 B=HH(K)
58000 A=B-V
58100 V=B
58200 IF(V)GO TO 82
58300 85 W=V
58400 IF(A.GT.O11)GO TO 89
58410 C IF(A.GT.O1)GO TO 89
58500 C WAS 0.011 ***** NOW IS AGAIN 12/81
58600 C .GT. BECAUSE OF ROUND-OFF ERROR (WAS 0.01 ABOVE AND BELOW 10/79)
58700 T=5
58800 IF(HH(K+1)-V.LE.O11)T=2
58810 C IF(HH(K+1)-V.LE.O1)T=2
58900 C WAS 0.011
59000 PX=PX+T
59100 C THIS FOR BARS, KSIG, METER
59200 GO TO 189
59300 89 PX=PX+14.0*EXP(ALOG(A)*0.5849624)
59400 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
59500 CC89 PX=PX+PFIBX(A)
59600 189 E(K)=PX
59700 IF(LF.NE.0)GO TO 86
59800 GO TO 81
59900 82 LF=K
60000 83 K=K+1
60100 V=HH(K)
60200 IF(V)GO TO 83
60300 A=V-W
60400 GO TO 85
60500 86 LL=LF-1
60600 D=E(K)-E(LL)
60700 87 S=-HH(LF)-HH(LL)
60800 T=HH(K)-HH(LL)
60900 T=S/T
61000 C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
61100 E(LF)=E(LL)+D*T
61200 LF=LF+1
61300 IF(LF.NE.K)GO TO 87
61400 LF=0
61500 GO TO 81
61600
61700 1433 GO TO 2433
61800 TYPE 410,(E(K),K=1,KL)
61900 WRITE(21,410)(E(K),K=1,KL)
62000 C 5 IS SPACE AFTER 1ST BARLINE
62100 2433 IF(Q(2).EQ.18)RNEXT=RNEXT-3.6
62200 C PUSH CLOSER TO PREVIOUS BARLINE IF 1ST ITEM IS METER
62300 R8=RNEXT
62400 C POS OF 1ST BAR = END OF PREV. LINE
62500 IF(ENDLN.EQ.0)RNEXT=9
62600 C MAKES ROOM FOR 1ST CLEF.
62700 KL=KL-1
62800 J=0
62900 R5=0
63000 KK=1
63100 JD=1
63200 W=0
63300 LF=0
63400
63500 DO 80 K=1,N
63600 IF(NORH(L,K))GO TO 80
63700 A=Q(MM(K))
63800 IF(ZERO(A,W).EQ.0)GO TO 80
63900 C SKIP IF SAME POS OF NOTE OR REST.
64000 W=A
64100 R7=R8
64200 190 J=J+1
64300 IF(J.LE.KL)GO TO 290
64400 203 FORMAT(' FOUND CENTERED WHOLE REST!')
64500 2203 LL=0
64600 IF(JCEN.GE.0)GO TO 220
64700 TYPE 203
64800 GO TO 121
64900 220 JJJ=-1
65000 L=0
65100 120 W=LL
65200 A=0
65300 DO 124 KB=1,N
65400 LF=NN(KB)
65500 IF(LF.GT.2)GO TO 124
65600 IF(LF.LE.0)GO TO 124
65700 KE=MM(KB)
65800 IF(Q(KE-1).NE.W)GO TO 124
65900 C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
66000 JD=6
66100 IF(LF.EQ.2)JD=4
66200 A=A+Q(KE+JD)
66300 124 CONTINUE
66400 TYPE 123,LL,A
66500 LL=LL+1
66600 IF(L.EQ.0)L=A*100.+.5
66700 C SAVE NUM. OF BEATS FIRST TIME.
66800 IF(L.NE.A*100.+.5)JJJ=0
66900 C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
67000 IF(LL.LT.KPG)GO TO 120
67100 IF(JJJ.NE.0)GO TO 121
67200 JJJ=0
67300 DO 320 KB=2,JJ
67400 A=HH(KB)-HH(KB-1)
67500 IF(A.LE.O1)GO TO 320
67600 C SKIP BAR LINE VALUES (.01)
67700 JJJ=JJJ+1
67800 HH(JJJ)=4./A
67900 C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
68000 320 CONTINUE
68100 TYPE 420,(HH(KB),KB=1,JJJ)
68200 TYPE 421
68300 421 FORMAT(' **** COMPOSITE RHYTHM ERROR '/
68400 1 ' **** OR RHYTHM CROSSES BAR '/
68500 1 ' **** OR MISALIGNED NOTES')
68600 PAUSE
68700 GO TO 90
68800 420 FORMAT(10F8.2)
68900 123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
69000 121 PAUSE' *****RHYTHM MISMATCH*****'
69100 GO TO 90
69200 290 IF(DUMMY(JD).NE.J)GO TO 190
69300 JD=JD+1
69400 90 R8=RNEXT+E(J)
69500 R4=R5
69600 R5=A
69700 X=(R8-R7)/(R5-R4)
69800 S=R7-R4*X
69900 DO 91 L=KK,K
70000 LL=MM(L)
70100 91 Q(LL)=S+X*Q(LL)
70200 KK=K+1
70300 80 CONTINUE
70400
70500 CCC IF(KK.GT.K)GO TO 180
70600 IF(KK.GT.N)GO TO 180
70700 C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
70800 R7=Q(LL)-R5
70900 C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
71000 CCC DO 280 L=KK,K
71100 DO 280 L=KK,N
71200 LL=MM(L)
71300 280 Q(LL)=R7+Q(LL)
71400 180 JJ=JJ2-2
71500 L=JJ2
71600 M=0
71700 C FLAG FOR REST AT START OF LINE
71800
71900 JJJ=-1
72000 C FLAG FOR 1ST BAR OF LINE 12/77
72100 V=0
72200 ACCI=0
72300 DO 12 J=1,JJ
72400 R=CODEN(KPN,J,Q,LA)
72500 CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
72600 IF(R.EQ.4)GO TO 680
72700 IF(M)GO TO 780
72800 IF(R.NE.2)GO TO 780
72900 C NEXT FOR RESTS
73000 ACCI=ACCI+.5
73100 C ADD A LITTLE FOR TOTAL NUM. OF NOTES AND RESTS.
73200 C SHOULD WE ALSO CONSIDER CLEFS?? MAYBE ADD LATER.
73300 IF(KBR.EQ.0)GO TO 12
73400 C LOOK FOR RESTS AT FRONT OF LINE.
73500 X=0
73600 CALL TURN(J,JJ,1,X)
73700 PGTRN(KBR)=PGTRN(KBR)+X
73800 M=-1
73900
74000 780 IF(R.NE.1)GO TO 12
74100 IF(V.NE.Q(LA+3))GO TO 782
74200 IF(JACC)GO TO 781
74300 782 ACCI=ACCI+.5
74400 IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
74500 JACC=-1
74600 V=1
74700 C KPG=NUMB. OF STAVES BEING CONSIDERED. (IF 1, THEN ALL ACCIS ARE 'BIG')
74800 IF(KPG.GT.1)V=RSTFAC(IFIX(Q(LA+2))+1)
74900 CCCC V=RSTFAC(IFIX(Q(LA+2))+1)
75000 CC ACCI=ACCI+ACCISZ*RSTFAC(IFIX(Q(LA+2)))
75100 CCCC ACCI=ACCI+ACCISZ*V
75200 ACCI=ACCI+V
75300 C ADD SPACE FOR ACCIDENTALS*STAFF SIZE -- SEE DATA FOR ACCISZ.
75400 V=Q(LA+3)
75500 781 M=-1
75600 IF(NOGRCE)GO TO 12
75700 C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
75800 C FOUND A NOTE
75900 C************************* IF(Q(LA+9).GT.0.05)GO TO 12
76000 IF(Q(LA+9).NE.4.0/88.0)GO TO 12
76100 C JUMP IF NOT A GRACE NOTE
76200 R=Q(LA+2)
76300 C THE STAFF NUM.
76400 DO 580 LF=J+1,JJ
76500 IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
76600 IF(Q(JD+2).NE.R)GO TO 580
76700 IF(Q(JD).LT.7)GO TO 580
76800 IF(Q(JD+9).EQ.0)GO TO 580
76900 C CHORD NOTE
77000 R4=Q(LA+3)
77100 CC R4=Q(LA+3)-1
77200 R5=Q(JD+3)
77300 C THE STAFF # IS IN R2
77400 R8=RSTFAC(IFIX(R2+1))+.5
77500 IF(Q(JD+4).LT.80)R8=R8*2
77600 C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
77700 R8=R5-R8
77800 CC R8=R5-R8-1
77900 CCC IF(R4.EQ.R5)GO TO 12
78000 IF(R4.NE.R5)GO TO 480
78100 C GRACE NOTE AT START OF LINE ***** FIX THIS????
78200 DO 880 KE=1,LF-1
78300 880 Q(KPN(KE)+3)=R8
78400 C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
78500 GO TO 12
78600 480 R2=Q(LA+2)
78700 R9=R5
78800 CALL PTMOVE(Q,KPN)
78900 CC TYPE 9999,Q(J+3),Q(JD+3)
79000 CC9999 FORMAT(2F)
79100 GO TO 12
79200 580 CONTINUE
79300 GO TO 12
79400 C ABOVE FOR GRACE NOTE SPACING.
79500 680 KBR=KBR+1
79600 C BAR LINE COUNTER
79700 T=Q(LA+3)
79800 C TOTAL SPACE
79900 X=0
80000 CALL TURN(J-1,1,-1,X)
80100 CALL TURN(J+1,JJ,1,X)
80200 222 PGTRN(KBR)=X
80300 C FINDS PAGE-TURN POSSIBILITIES
80400 C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
80500 BFAC=.8
80600 CCC BFAC=.756
80700 IF(KPG.GT.1)CALL BARFAC(KPG,BFAC,JK)
80800 CC IF(KPG.LE.1)GO TO 3112
80900 C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
81000 CC R=RSTFAC(1)
81100 CC DO 5112 K=2,KPG
81200 CC5112 IF(R.NE.RSTFAC(K))GO TO 6112
81300 CC GO TO 3112
81400 C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
81500 C FIND LINE WITH MOST ACTIVITY.
81600 C ALL THIS SORT OF WORKS. SOMEDAY REVIEW IT.********
81700 CC6112 DO 1112 K=1,8
81800 CC1112 RN(K)=0
81900 CC DO 112 K=JK,J-1
82000 CC R=CODEN(KPN,K,Q,JD)
82100 CC IF(R.GT.3.)GO TO 112
82200 CC A=1.0
82300 C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
82400 CC IF(R.EQ.2)A=0.6
82500 C SKIP NON-RHYTHM CHORD NOTES. RESTS ARE CONSIDERED LESS IMPORTANT.
82600 CC IF(R.NE.1)GO TO 4112
82700 CC IF(Q(JD).LT.7)GO TO 112
82800 CC IF(Q(JD+9).LE.0)GO TO 112
82900 CC4112 LF=Q(JD+2)+1
83000 CC RN(LF)=RN(LF)+A
83100 CC112 CONTINUE
83200 CC JD=1
83300 CC B=RN(1)*RSTFAC(1)
83400 CC DO 2112 K=2,8
83500 CC A=RN(K)*RSTFAC(K)
83600 CC IF(A.LE.B)GO TO 2112
83700 CC JD=K
83800 CC B=A
83900 CC2112 CONTINUE
84000 CC BFAC=BFAC*(RSTFAC(JD)+.1)
84100 C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
84200 CXX BFAC=.84*RSTFAC(JD)
84300 3112 IF(JJJ)RNEXT=RNEXT-6
84400 C JJJ=-1 IF 1ST BAR OF LINE. 12/77
84500 JJJ=0
84600 BARS(KBR)=(T-RNEXT+ACCI)*BFAC
84700 C SIZE OF THIS MEASURE + ACCISZ*ACCIDENTALS
84800 ACCI=0
84900 C RESET ACCI (SPACE FOR ACCIS AND TOTAL NUM. OF NOTES)
85000 K=J
85100 JK=J+1
85200 C SET UP POINTER FOR NEXT BAR'S ITEMS.
85300 RNEXT=T
85400 12 CONTINUE
85500
85600 IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
85700 RNEXT=RNEXT+5
85800 CCC 11/9/78 RNEXT=RNEXT+3
85900 JJ2=L
86000 C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
86100 CC???380 LCNT=0
86200 CC??? NDPY=0
86300
86400 C JJ2 IS END OF PNTR DATA
86500 11 IF(IPG.EQ.2)NMPG=NAMX
86600 C IPG=2=REORDER INPUT FILE ONLY.
86700 C WHY DID I WRITE 2 EXTRA WORDS AT END OF Q ARRAY. (MAYBE NEEDED∞
86800 C BUT IF 1ST EXTRA WAS NEG. (OR ZER0?) CAUSED BUG IN NEW 'INUMS' ROUTINE.
86900 JPQ=KPN(JJ2-1)+1
87000 Q(JPQ-1)=0
87100 CALL PUTEXT(NMPG,'PAG')
87200 CALL EXTOUT(RSTFAC,128)
87300 C*** CALL EXTOUT(PN,JJ2)
87400 C NEW SAVE FORMAT DOESN'T NEED ABOVE 3/80
87500 CALL EXTOUT(Q,JPQ)
87600 IF(IPG.EQ.2)CALL EXIT
87700 CALL FINEXT
87800
87900 LASTNM=NMPG
88000 NMPG=NMPG+2
88100 IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
88200 C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
88300 IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
88400 IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
88500 122 ENDLN=RNEXT
88600 END